--    Copyright (c) 2010 Eric Man. 
--    
--    Permission is hereby granted, free of charge, to any person obtaining a copy of 
--    this software and associated documentation files (the "Software"), to deal in 
--    the Software without restriction, including without limitation the rights to 
--    use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
--    of the Software, and to permit persons to whom the Software is furnished to do 
--    so, subject to the following conditions:
--    
--    The above copyright notice and this permission notice shall be included in all 
--    copies or substantial portions of the Software.
--    
--    THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 
--    IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 
--    FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 
--    AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 
--    LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 
--    OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 
--    SOFTWARE.
--    
--    This is work from derived from lualisp: http://code.google.com/p/lualisp/ and 
--     arc http://arclanguage.org
--    

--global variable storing tests
local test = {}

function runtests(s)
    print("tests", "passed?")
    for k, v in pairs(test) do
        if not s or k == s then
            print(k, v() and "ok" or "failed, print out above.")
        end
    end
end

-- runtime test
function atest(a, b, fn)
    return function() 
        fn = fn or evalstr
        local r = fn(a):strf() == "("..b..")"
        return r or print(fn(a):strf())
    end
end

function isin(v, v1, ...)
    return v == v1 or ... and isin(v, ...)
end

-- arc's tagging system's clone.
function new (mt, value)
    return setmetatable(value, mt)
end

function cast (value, nmt)
    return setmetatable(value, nmt)
end

function typeof (value)
    return getmetatable(value)
end

function istype (value, t, ...)
    return typeof(value) == t or ... and istype(value, ...)
end

-- null type for ending lists.
local null_type = {"null", __tostring=function(self) return "null" end}

function null()
    return setmetatable({}, null_type)
end

function isnull(t)
    return type(t) == "table" and #t == 0 or istype(t, null_type)
end

function isnil(t)
    return t == nil
end

function is(t, ...)
    return not isnull(t) and t ~= nil
end

-- linked list, will be useful later.

local pair_type = {"pair", __tostring = function(self)
    return "("..tostring(self:car())..". "..tostring(self:cdr())..")"
end, car, cdr, scar, scdr, caar, cddr, cadr, cdar};

pair_type.__index = pair_type

function newp(car, cdr)
    return new(pair_type, {car, cdr})
end

function pushp(pair, pair2)
    pair[2] = pair2
    return pair
end

function isp(p, ...)
    return (type(p)=="table" and #p == 2 or istype(p, pair_type)) and (... and isp(...) or true)
end

function addp(pair, pair2)
    if not isp(pair) then
        cast(pair, pair_type)
    end
    if is(pair:cdr()) then
        return addp(pair:cdr(), pair2)
    end
    pair:scdr(pair2)
    return pair2
end

function scar(p, v)
    p[1] = v
    return v
end

function scdr(p, v)
    p[2] = v
    return v
end

function car(p)
    return p[1]
end

function cdr(p)
    return p[2]
end

function cdar(p)
    return p[2][1]
end

function cadr(p)
    return p[1][2]
end

function caar(p)
    return p[1][1]
end

function cddr(p)
    return p[2][2]
end

--get last car value
function plast(p)
    if isp(p:cdr()) then
        return plast(p:cdr())
    end
    return p:car()
end

pair_type.car, pair_type.cdr, pair_type.scar, pair_type.scdr = car, cdr, scar, scdr
pair_type.caar, pair_type.cddr, pair_type.cadr, pair_type.cdar = caar, cddr, cadr, cdar

function tolist(t, s)
  s = s or 1
  return not t[s] and null() or newp(t[s], tolist(t, s + 1))
end

function toar(l)
    t = {l:car(), unpack(l:cdr())}
    return t
end

-- arc atom/list types
-- fns w/ "a" prefix after verb generally works only with arc atom/list types. 
local arc_atom_type_type = {"arc_atom_type", __tostring = function(self) return self[1] end}

local aat={}

-- aat def: conforming aat instances will implement the .strf, .val and .__tostring functions
function newaat (name)
    local _aat = new(arc_atom_type_type, {name})
    
    _aat.__index = function(self, k)
        if type(k) == "string" then
            return _aat[k]
        end
    end
    
    _aat.val = function(self)
            return (self[1])
        end
        
    _aat.__tostring = function(self)
            return isac(self) and "(" .. tostring(self:car()) .. " . " .. tostring(self:cdr()) .. ")"
                or "#<"..tostring(typeof(self))..":\""..tostring(self:val()).."\">"
        end
    
    return _aat
end

function isaat(a)
    return istype(a, arc_atom_type_type)
end

--type names in lua
local type_ar = {"STR", "NUM", "SYM", "OP", "PAIR", "LPAREN", "RPAREN", "FUN"}

--type labels in arc
local type_la = {"string", "num", "sym", "OP", "cons", "LPAREN", "RPAREN", "procedure"}
for i, v in ipairs(type_ar) do
    aat[v] = newaat(type_la[i] or v)
end

-- strf = string format... easier to type than fstr
function aat.STR.strf(self, inlist)
    return (inlist and " . " or "").. "\"" .. self:val() .. "\""
end

function aat.NUM.strf(self, inlist)
    return (inlist and " . " or "").. self:val()
end

function aat.SYM.strf(self, inlist)
    return isa(self) and aat.NUM.strf(self, inlist) or inlist and "" or (self:val() or "()")
end

function aat.PAIR.strf(self, inlist)
    return (inlist and " " or "(") .. self:car():strf() .. (self:cdr():strf(true) .. (inlist and "" or ")"))
end

function aat.FUN.__tostring(self)
    local ts = type(self:val()) == "function" and tostring(self:val()) or tostring(self:val():cdar():strf())
    return isac(self) and "(" .. tostring(self:car()) .. " . " .. tostring(self:cdr()) .. ")"
        or "#<"..tostring(typeof(self))..":\""..ts.."\">"
end

aat.FUN.strf = aat.FUN.__tostring

aat.PAIR.car, aat.PAIR.cdr, aat.PAIR.scar, aat.PAIR.scdr = car, cdr, scar, scdr
aat.PAIR.caar, aat.PAIR.cddr, aat.PAIR.cadr, aat.PAIR.cdar = caar, cddr, cadr, cdar

-- arc atom
local aatlookup = {["."] = aat.OP, ["t"] = aat.SYM}

function isnum(v)
    return string.find(v, "%d+") and string.find(v, "^+?-?%d*%.?%d*$")
end

function newaa(v, t)
    t = t or aatlookup[v]
    if v == true or v == nil or v == false then
        t = aat.SYM
        v = v and "t" or "nil"
    end
    local isnum = not t and ( type(v)=="string" and isnum(v) or type(v) == "number")
    return new(t or isnum and aat.NUM or type(v)=="function" and aat.FUN or aat.SYM, {isnum and tonumber(v) or v, loc = nil})
end

function isop(v)
    return istype(v, aat.OP)
end

function issym(v)
    return isa(v) and istype(v, aat.SYM)
end

function ist(v)
    return issym(v) and v:val() == "t"
end

function isfun(v)
    return istype(v, aat.FUN)
end

-- macroes are functions tagged with "mac"
function ismac(v)
    return istype(ar_rep(v), aat.FUN) and istype(typeof(v), aat.SYM) and typeof(v):val() == "mac"
end

-- arc (): supposedly immutable, and `basically` compatible with null's functions
function newanil() 
    return cast(null(), aat.SYM)
end

-- "nil" sym is also some version of nil. not compatible with null
function isanil(t)
    return isnull(t) or typeof(t) == aat.SYM and t:val() == "nil"
end

-- `something`
function isa(t)
    return type(t)=="table" and not isanil(t)
end

-- arc cons, basically compatibile with pair's functions
function newac(car, cdr)
    return cast(newp(car, cdr or newanil()), aat.PAIR)
end

function isac(p)
   return istype(p, pair_type, aat.PAIR) 
end

-- fn has optional extra return, which would get spliced onto the result as cdr if present
function acmap(fn, ...)
    local varargs = {...}
    local args = {}
    if isp(unpack(varargs)) then
      for i, v in ipairs(varargs) do
          args[#args+1] = v:car()
          varargs[i] = v:cdr()
      end
    
      local car, cdr = fn(unpack(args))
      
      if isp(cdr) then
      --splice action
          addp(cdr, acmap(fn, unpack(varargs)))
      else
          cdr = acmap(fn, unpack(varargs))
      end
      return newac(car, cdr)
    end
    return newanil()
end


-- ar to arc list
function toalist(t, s)
  s = s or 1
  if isanil(t[s]) and not t[s + 1] then
    return newanil()
  end
  if not t[s+1] then
    return t[s]
  end
  return newac(t[s], toalist(t, s + 1))
end

function atoar(l)
    return isa(l) and {isp(l:car()) and l:car() or l:car():val(), unpack(atoar(l:cdr()))} or null()
end

-- arc paren
function newap(v)
    return new(v == "(" and aat.LPAREN or aat.RPAREN, {v})
end

function isap(v)
    return (v == "(" or v == ")")
end

-- arc error

function aerror(m, loc)
    print("Error:"..(loc or "").. " ".."\"" .. m .. "\"")
end

-- parser

-- long ops first
local op_ar = {",@", ",", "`", '\''}
local op_map = {"unquote-splicing", "unquote", "quasiquote", "quote"}
local spf = {}
local wh_ar = {"    ", " ", "\n"}
local p_ar = {"(", ")"}

local oplookup = {}
local whlookup = {}

for i, v in ipairs(op_ar) do
    oplookup[v] = v
    op_map[v] = op_map[i]
    spf[op_map[i]] = op_map[i]
    op_map[i] = nil
end

for i, v in ipairs(wh_ar) do
    whlookup[v] = v
end

function isspf(v)
    return issym(v) and spf[v:val()]
end

function ifp(c)
    return isap(c) and c
end

function ifop(c)
    return oplookup[c] and c
end

function ifwh(c)
    return whlookup[c] and c
end

function ifq(c)
    return c == "\"" and c
end

function ifac(cons)
    return isac(cons) and c
end

function char(str, i)
    return string.sub(str, i or 1, i or 1)
end

-- get op at ^str
function gop(str, s)
   s = s or 1
   return string.match(str, "^"..op_ar[s]) or s < #op_ar and gop(str, s+1)
end

-- get str at ^str
function gstr(str, loc, r)
    
    local c = char(str)
    if ifq(c) then
        return r
    end
    
    c = c .. (c == "\\" and char(str, 2) or "")
    if #str == 0 then
        aerror("Unbalanced quote: ".. r, loc)
        return nil
    end
    return gstr(string.sub(str, #c + 1), loc, r .. c)
end

-- get tree of tokens from str
function gtokens(str, loc, r)
    local c, loc, r = char(str), loc or 1, r or {}
    local op, q, p, wh = gop(str), ifq(c), ifp(c), ifwh(c)
    local lex = p or op or wh or q and q .. gstr(string.sub(str, 2), loc, "") .. q
        or string.match(str, "^[^"..table.concat(op_ar)..table.concat(p_ar)..table.concat(wh_ar).."]+")
    local left = lex and string.sub(str, #lex + 1) or ""
    
    if lex and not ifwh(c) then
        local token = p and newap(lex) or op and newaa(lex, aat.OP) 
            or q and newaa(string.sub(lex, 2, #lex-1), aat.STR) or newaa(lex)
        token.loc = loc
        r[#r + 1] = token
        return gtokens(left, loc + #lex, r)
    elseif #str > 0 then
        return gtokens(left, loc + #(lex or ''), r)
    end
    
    return r
end

-- tokens to s-exprs, r array w/ list items
function gexpr(t, s, r, p)
    r = r or {}
    s = s or 1
    p = p or 0
    
    if s > #t then
        return r, s, p
    end
    
    local c = t[s]
    
    if istype(c, aat.RPAREN) then
        r[#r+1] = newanil()
        r[#r].loc = c.loc
        if p <= 0 then
            aerror("too many right parens "..s)
        end
        return r, s, p - 1
    end
    
    if istype(c, aat.LPAREN) then
        p = p + 1
        s = s + 1
        local _r, _s, _p = gexpr(t, s, nil, p)
        local l = c.loc
        c = toalist(_r)
        c.loc = l
        s, p = _s, _p
        p = _p
    end
    
    if istype(c, aat.OP) and c:val() == "." then
        s = s + 1
        if #r == 0 then
            aerror("illegal use of \".\"", c.loc)
        end
        local _r, _s, _p = gexpr(t, s, nil, p)
        r[#r+1]  = toalist(_r):car()
        r[#r].loc = c.loc
        return r, _s, _p
    end
    
    r[#r+1] =  c
    return gexpr(t, s + 1, r, p)
end

-- expand operators, r list
function opex(expr)
    if not isp(expr) then
        aerror("unexpected end of expression")
        return expr
    end
    expr.loc = expr.loc or expr:car().loc
    if isop(expr:car()) then
        local exop = opex(expr:cdr())
        if isanil(exop) then
            return exop
        end
        expr:scar(toalist{newaa(op_map[expr:car():val()], aat.SYM), exop:car() or newanil(), newanil()})
        expr:scdr(expr:cddr())
        expr:car().loc = expr:car().loc or expr.loc
    end
    
    if isac(expr:car()) then
        expr:scar(opex(expr:car()))
    end
    
    if isac(expr:cdr()) then
        expr:scdr(opex(expr:cdr()))
    end
    return expr
end

-- get ast from str
function parse(str)
    local r, s, p = gexpr(gtokens(str))
    if p > 0 then
        aerror("too many left parens")
    end
    r[#r+1] = newanil()
    return opex(toalist(r))
end

test.parse = atest("(+ 1 '(2) '3)", "(+ 1 (quote (2)) (quote 3))", parse)

test.parse1 = atest("`(,())", "(quasiquote ((unquote ())))", parse)

-- scope
local scope_type = {"scope", __tostring = function(self)
        local t = "("
        for k, v in pairs(self) do
            t=t..("["..k.." = "..tostring(v).."]")
        end
        return t..")"
    end, 
    __index = function (self, k)
        return rawget(self, "__index") and rawget(self, "__index")[k]
    end}

-- default scope
function dsc()
    return {}
end

-- add to default scope
function def(name, v)
    local sc = dsc()
    sc[name] = v
    function dsc()
        return sc
    end
end

-- convert lua types in tree to arc types
function rcon(r)
    if not isa(r:car()) and not isanil(r:car()) then
        r:scar(newaa(r:car()))
    end
    
    if not isa(r:cdr()) and not isanil(r:cdr()) then
        r:scdr(newaa(r:cdr()))
    end
    
    if isac(r:car()) then
        rcon(r:car())
    end
    
    if isac(r:cdr()) then
        rcon(r:cdr())
    end
    return r
end

-- its called xdef in arc src
function xdef(name, fn)
    -- used for simple functions like +, ignore env
    def(name, newaa(function(args, env)
            local r = fn(unpack(atoar(args)))
            r = isac(r) and rcon(r) or newaa(r)
            return r
        end, aat.FUN))
end

def("t", newaa("t", aat.SYM))

def("nil", newaa("nil", aat.SYM))

xdef("car", car)

xdef("cdr", cdr)

xdef("cons", newac)

xdef("len", string.len)

function bound(a, env)
    return istype(a, aat.SYM) and eget(env, a:val()) or (isanil(a) and type(a:val()) == "string") and true
end

def("bound", newaa(function(args, env)
    return bound(args:car(), env) and eget(env, "t") or eget(env, "nil")
end, aat.FUN))

function eqa(a, b, ...)
    if not b then
        return true
    end
    return (typeof(a) == typeof(b) and a:val() == b:val() and (... and eqa(b, ...) or true))
end

def("is", newaa(function(args)
    return eqa(unpack(toar(args))) and newaa("t", aat.SYM) or newaa("nil", aat.SYM)
end, aat.FUN))

test.is = atest('(is \'mac \'mac)', "t")

function astrf(self)
    if type(typeof(typeof(self)))=="table" and typeof(typeof(self)) ~= arc_atom_type_type then
        return "#3(tagged "..typeof(self):strf().." "..self:val():strf()..")"
    end
    return typeof(self).strf(self)
end

function ar_tag(t, value)
    t.__index = t
    t.strf = astrf
    return newaa(value, t)
end

def("annotate", newaa(function (args) 
           return ar_tag(args:car(), args:cdar())
       end, aat.FUN))

def("type", newaa(function(v) return typeof(v:car()) end, aat.FUN))

function ar_rep(v)
    return not isaat(typeof(v)) and isa(v) and v:val() or v
end

def("rep", newaa(function(v) return ar_rep(v:car()) end, aat.FUN))

function newsc(t)
    return new(scope_type, t or dsc())
end

test.rep = atest('(rep (annotate 1 2))', '2')

test.atype = atest('(type (annotate 1 2))', '1')

test.annot = atest('(annotate 1 (annotate 2 3))', '#3(tagged 1 #3(tagged 2 3))')

-- env

local env_type = {"env", __tostring = function(self)
    return "["..tostring(self[1]) .. "]"
end}

function newenv(t)
    local gsc = newp(t and cast(t, scope_type) or newsc(), null())
    return new(env_type, {gsc, g = gsc})
end

function pushsc(env, sc)
    env[1] = newp(sc, env[1])
    sc.__index = env[1]:cdar()
    return sc
end

function popsc(env)
    local top = env[1]:car()
    env[1] = env[1]:cdr()
    return top
end

function eget(env, k)
    return env[1]:car()[k]
end

function eset(env, k, v)
    env[1]:car()[k] = v
    return v
end

function esetg(env, k, v)
    env.g:car()[k] = v
end

function test.eget()
    local env = newenv({["+"] = 3, car = 4})
    pushsc(env, newsc({["ab"] = 6}))
    pushsc(env, newsc({["c"] = 8}))
    esetg(env, 'e', 3)
    return eget(env, "e") == 3
end

-- eval
function read(f, q, l, sq, r)
    f, l, r = f or io.stdin, l or 0, r or ""
    local esc = false
    local line = f:read("*line")
    if line then
        for i = 1, #line, 1 do
            local c = char(line, i)
            if not esc then
                if c == "\"" then
                    q = not q
                end
                if not q and c == ";" then
                    break
                end
                sq = (isin(c, '\'', '`') or sq and c == ',') or c == "\n" and sq or false
                l = not q and (c == "(" and l+1 or (c == ")" and l - 1)) or l
            end
            esc = c == "\\"
            r = r .. c
        end
        if l>0 or q or sq or esc then
            return read(f, q, l, sq, r .. "\n")
        end
    end
    return r
end

function plus(sum, ...)
    return sum and sum + plus(...) or 0
end
xdef("+", plus)

function minus(sum, ...)
    return sum and sum - minus(...) or 0
end
xdef("-", minus)

function mult(sum, ...)
    return sum and sum * mult(...) or 1
end
xdef("*", mult)

function div(sum, ...)
    return sum and sum / div(sum, ...) or 1
end
xdef("/", div)

function cmpfn(cmp)
    local function fn(a, b, ...)
        return cmp(a, b) and (... and fn(b, ...) or true)
    end
    return fn
end

xdef(">", cmpfn(function(a, b) return a > b end))

xdef(">=", cmpfn(function(a, b) return a >= b end))

xdef("<", cmpfn(function(a, b) return a < b end))

xdef("<=", cmpfn(function(a, b) return a <= b end))

xdef("prn", print)

function spf.quote(env, args)
    return args:car()
end

function isuq(c)
    return isspf(c) and (c:val() == "unquote" or  c:val() == "unquote-splicing")
end


function spf.quasiquote (env, args)
    if not isac(args:car()) then
        return args:car()
    end
    
    local spf = args:caar()
    
    if isspf(spf) and spf:val() == "unquote" then
        return evalexpr(args:cadr(), env):car()
    elseif isspf(spf) and spf:val() == "unquote-splicing" then
        aerror("Invalid context for unquote-splicing", args.loc)
    end
    
    local ruqt = {}
    function ruqt.ruq(v)
        if isac(v) and isuq(v:car())  then
            local cv = v:car():val()
            local vcd = v:cdr()
            if cv == "unquote" then
                return evalexpr(vcd, env):val()
            elseif cv == "unquote-splicing" then
                return unpack(evalexpr(vcd, env):val())
            end
        elseif isac(v) then
            v = acmap(ruqt.ruq, v)
        end
        return v
    end
    
    return acmap(ruqt.ruq, args:car())
end

function spf_if(env, args)
    local r
    if isanil(args) then
        return newanil()
    elseif isanil(args:cdr()) then
        return eval(args:car(), env):car()
    elseif isa(eval(args:car(), env):car()) then
        return eval(args:cdar(), env):car()
    else
        return spf_if(env, args:cddr())
    end
end

spf['if'] = spf_if

test['if'] = atest('(if nil 1 nil 2 (+ 1 2))', '3')

function spf.assign(env, args)
    if (issym(args:car())) then
        if not ist(args:car()) then
            esetg(env, args:car():val(), eval(args:cdar(), env):car())
        else
            aerror("Can't rebind t")
        end
    else
        aerror("First arg to set must be a non-constant symbol "..tostring(args:car():val()))
    end
    return eget(env, args:car():val())
end

test.assign = atest('(assign a (+ 4 5))', '9')
function spf.fn(env, args)
    return newaa(args, aat.FUN)
end

function bind(scope, fargs, args)
   if isp(fargs) then
      scope[fargs:car():val()] = args:car()
      bind(scope, fargs:cdr(), args:cdr())
   elseif is(fargs) then
      scope[fargs:val()] = args
   end 
end

function evalfn(fatom, args, env)
    if type(fatom:val()) == "function" then --prim fn
        return fatom:val()(args, env)
    else --defined fn
        bind(pushsc(env, newsc({})), fatom:val():car(), args)
        -- needs to copy.
        local r =  plast(evalexpr(fatom:val():cdr(), env))
        popsc(env)
        return r
    end
end


test.fn = atest('((fn (a) a) \'(9 10))', '(9 10)')
test.fn2 = atest('((fn (a . b)  b) 1 2 3)', '(2 3)')
test.fn3 = atest('((fn args `((fn () ,@args))) 1)', '((fn () 1))')

--get loc of expr... doesnt work properly so remains unused
function exprloc(expr)
    if not expr.loc then
        return exprloc(expr:car())
    end
    return expr.loc
end

test.recur = atest('((assign r (fn (a) (if (> a 0) (r (- a 1)) "done"))) 3)', "\"done\"")

function evalexpr(expr, env)
    if isanil(expr) or ist(expr) then
        return expr
    end
    if issym(expr) then -- note: nil and () makes issym return false
        return eget(env, expr:val()) or aerror("reference to undefined identifier: "..tostring(expr:val()))
    end
    if isac(expr) then 
        expr.loc = expr.loc or expr:car().loc
        if isac(expr:car()) and type(spf[expr:caar():val()])=="function" then
          if isspf(expr:caar()) then
            expr = newac(spf[expr:caar():val()](env, expr:cadr()), evalexpr(expr:cdr(), env))
            return expr
          end
        end
        
        local to_eval = isac(expr:car())
        expr = newac(evalexpr(expr:car(), env), evalexpr(expr:cdr(), env))
        local list = expr:car()
        if (to_eval) then
            if ismac(list:car()) then
                expr:scar(evalfn(ar_rep(list:car()), expr:car():cdr(), env))
                return evalexpr(expr, env)
            elseif isfun(list:car()) then
                expr:scar(evalfn(list:car(), list:cdr(), env))
                return expr
            else
                aerror("Function call on inappropriate object "..tostring(list:car():val()).." "..list:cdr():strf())
            end
            
        else
           
        end
    end
    return expr
end

test.mac = atest('(assign do (annotate \'mac (fn args `((fn () ,@args)))))', '#3(tagged mac #<procedure:"(quasiquote ((fn () (unquote-splicing args))))">)')


function test.mac2()
    evalstr('(assign testm (annotate \'mac (fn (a) `(+ ,a ,a))))')
    return evalstr('(testm 12)'):strf() == "(24)"
end

function eval(expr, env)
    return evalexpr(newac(expr, newanil()), env)
end

test.eval = atest('(eval (cons + \'( 1 2)))', '3')

def("eval", newaa(function(e) return evalexpr(e, newenv()):car() end, aat.FUN))

function evalstr(str, env)
    env = env or newenv()
    return evalexpr(parse(str), env)
end

test.evalstr = atest("`(1 ,())", '(1 ())')

test.evalq = atest('\'(1 2 3)', '(1 2 3)')

test.evalqq = atest('`(1 2 3)', '(1 2 3)')

test.evalqq1 = atest('`(1 2 ,(+ 1 2))', '(1 2 3)')

function repl(r, env)
  env = env or newenv()
  
  if isp(r) then
    print(r:car():strf())
    r = r:cdr()
  end
  io.write("> ")
  
  if isp(r) then
    repl(r, env)
  end
  
  local m = read()
  
  return #m > 0 and repl(evalstr(m, env), env)
end

runtests()

print("implemented tokens: . ' ` , ,@ + - * / t nil car cdr cons fn if eval len type assign annotate type rep is bound")
print("to make a macro, tag the function with \'mac, e.g `(assign testm (annotate \'mac (fn (a) `(+ ,a ,a))))`")
repl()
